home *** CD-ROM | disk | FTP | other *** search
/ Item MB Quick & Easy 2.0 / Item MB Quick & Easy 2.0.iso / mbfacad / 7000165.lsp < prev    next >
Lisp/Scheme  |  1998-03-15  |  4KB  |  107 lines
  1. ;=====7.0.001.65  Winkelschraubleiste 8 Al E
  2. (EAITDBL "7000165")
  3. (EAITmsg "mb_mld10" "\n" "002" nil) (princ "........") (princ EAITnrx) (princ "\n")
  4. (princ)
  5.  
  6. (defun C:7000165D1 ( / P0 P01 P1 P2 P3 P10 P11 P12 P13 P14 P15 P16 PS0 PS1
  7.                      E1 SS1 Li Wi BName NL)
  8.    (EAITDBL "7000165")
  9.    (princ (strcat "\n\n" EAITbez1))
  10.    (EAITvari)
  11.    (if (not EAITlpr)(setq EAITlpr 0.0))
  12.    (EAITvars)
  13.    (setvar "ORTHOMODE" 0)
  14.    (setvar "OSMODE" 32)
  15.    (EAITmsg "mb_mld12" "\n" "015" nil)  ;1. Nutlinie
  16.    (setq NL (entsel " "))
  17.    (setq P01(osnap (cadr NL) EAITofnaec))
  18.    (setvar "APERTURE" 4)
  19.    (setvar "OSMODE" 0)
  20.    (setq P9 (osnap P01 EAITofend)
  21.          P10 (osnap P01 EAITofmit)
  22.          Wi1 (angle P9 P10)
  23.    )
  24.    
  25.    (EAITbpt nil nil (strcat (EAITmg "mb_mld14" "001")(princ " : ")(EAITmg "mb_mld10" "015")));Bezugspunkt auf zweiter Nutlinie : (RETURN = relativ)
  26.    (setq P1 (getpoint P01))
  27.    (if (= P1 nil)(setq P1 (EAITrpt)))
  28.    (setq PS1 (inters P1 (polar P1 (+ Wi1(/ Pi 2))10) P9 P10 nil))
  29.    (while (NOT(equal (distance P1 PS1) 8 0.0000000001))
  30.      (EAITmsg "mb_mld14" "\n\n" "002" nil)    ;Falscher Punkt !
  31.      (EAITbpt nil nil (strcat (EAITmg "mb_mld14" "003")(princ " : ")(EAITmg "mb_mld10" "015")));Bezugspunkt auf zweiter Nutlinie : (RETURN = relativ)
  32.      (setq P1 (getpoint P01))
  33.      (if (= P1 nil)(setq P1 (EAITrpt)))
  34.      (setq PS1 (inters P1 (polar P1 (+ Wi1(/ Pi 2))10) P9 P10 nil))
  35.    )
  36.  
  37.    (setvar "OSMODE" 512)
  38.    (initget (+ 1 2 4))
  39.    (EAITmsg "mb_mld14" "\n\n" "004" " :<")(princ EAITofnaec)(princ ">")  ;Richtung auf Profil (Punkt auf zweiter Nutlinie)
  40.    (setq P0 (getpoint P1))
  41.    (setq Wi (angle P1 P0))
  42.    (while (AND (NOT(equal Wi Wi1 0.000000001))(NOT (equal Wi (+ Wi1 Pi) 0.000000001)))
  43.      (EAITmsg "mb_mld14" "\n\n" "002" nil)    ;Falscher Punkt !
  44.      (initget (+ 1 2 4))
  45.      (EAITmsg "mb_mld14" "\n\n" "005" " :<")(princ EAITofnaec)(princ ">")  ;Neue Richtung auf Profil (Punkt auf zweiter Nutlinie)
  46.      (setq P0 (getpoint P1))
  47.      (setq Wi (angle P1 P0))
  48.    )    
  49.  
  50.    (setvar "OSMODE" 9)
  51.    (EAITmsg "mb_mld1" "\n" "005" " <")(princ EAITlpr)(princ "> ")  ;Laenge < >
  52.    (initget (+ 2 4))
  53.    (setq Li (getdist " "))
  54.    (if (= Li nil)(setq Li EAITlpr))
  55.    (setq Li (EAITck Li))
  56.    (setq Li (atof (rtos (abs Li) 2 1)))
  57.    (princ "\n  -> ")(princ Li)
  58.  
  59.    (setvar "OSMODE" 0)
  60.    (setq PS1 (inters P1 (polar P1 (+ Wi(/ Pi 2))10) P9 P10 nil)
  61.      P2 (mapcar '/ (mapcar '+ P1 PS1) '(2 2 2))
  62.      P3 (polar P2 Wi Li)
  63.          P11 (polar P2  (- Wi (EAITgib 90)) 8)
  64.          P12 (polar P11 Wi Li)
  65.          P13 (polar P12 (+ Wi (EAITgib 90)) 20)
  66.          P14 (polar P11 (+ Wi (EAITgib 90)) 20)
  67.          P15 (polar P2  (+ Wi (EAITgib 180)) 5)
  68.          P16 (polar P15 Wi (+ Li 10))
  69.    )
  70.    (if (/= (cdr (assoc 2 (entget (car NL)))) nil) (command EAITurs NL))
  71.    (command EAITzom EAITzomi (mapcar '/ (mapcar '+ P2 P3) '(2 2 2)) P12 P14)
  72.    (if (/= (ssget (polar P2 (+ Wi (/ Pi 4))(/ 4 (cos (/ Pi 4))))) nil)
  73.          (command EAITbru (polar P2 (+ Wi (/ Pi 4))(/ 4 (cos (/ Pi 4)))) EAITbre
  74.                           (polar P2 (+ Wi (/ Pi 2)) 4) (polar P3 (+ Wi (/ Pi 2)) 4)
  75.          )
  76.    )
  77.    (if (/= (ssget (polar P2 (- Wi (/ Pi 4))(/ 4 (cos (/ Pi 4))))) nil)
  78.          (command EAITbru (polar P2 (- Wi (/ Pi 4))(/ 4 (cos (/ Pi 4)))) EAITbre
  79.                           (polar P2 (- Wi (/ Pi 2)) 4) (polar P3 (- Wi (/ Pi 2)) 4)
  80.          )
  81.    )
  82.    (command EAITzom EAITzov)
  83.    (command EAITlay EAITlse "EAIT50" ""
  84.             EAITlin P11 P12 "" )
  85.    (setq E1 (entlast))
  86.    (command EAITlin P12 P13 P14 P11 ""
  87.             EAITlay EAITlse "EAITstpg" ""
  88.             EAITlin P15 P16 ""
  89.    )
  90.    (setq BName (EAITbnr)
  91.          SS1 (EAITSS E1)
  92.    )
  93.  
  94.    (command EAITblo BName P11 SS1 "")
  95.    (command EAITege BName P11 "" "" "")
  96.  
  97.    (setq Li (rtos (abs Li) 2 1))
  98.    (command EAITege (strcat EAITpfn "EAITinfo") (polar P11 (+ Wi (EAITgib 9)) 5) "" "" ""
  99.                     EAITbez1 EAITbez2 EAITlie1 EAITlie2 EAITwer1 EAITwer2 Li (rtos EAITb1 2 1) EAITnr
  100.    )
  101.  
  102.    (EAITvarz2)
  103.    (princ)
  104. );defun 7000165D1
  105.  
  106. (princ)
  107.